Software Vault: The Gold Collection/Software Vault - The Gold Collection (American Databankers) (1993).ISO/cdr05/ewrtgn10.zip/EWRTFGEN.PAS

Pascal/Delphi Source File | 1993-07-17 | 25KB | 1,048 lines

                              { EWRTFGEN }

(*********  Source code (C) Copyright 1992, by L. David Baldwin   *********)
(*********  Source code (C) Copyright 1993, by Patrick Philippot  *********)
(*********                All Rights Reserved                     *********)

{************************************************}
{                                                }
{ E! for Windows                                 }
{ (c) - Patrick Philippot - 1992,1993            }
{                                                }
{ EWRTFGEN Extension DLL - version 1.0           }
{                                                }
{ This DLL translates the current text to a      }
{ .RTF file suitable for the Windows Help        }
{ compiler, provided it complies to the syntax   }
{ defined by RTFGEN (see doc.).                  }
{                                                }
{************************************************}

{$C MOVEABLE DEMANDLOAD DISCARDABLE}

Library EWRTFGEN;
{$IFDEF DEBUG}
{$A+,G+,B-,D+,E-,F+,I-,N-,R+,S+,V-,L+,Q+,Y+,K+,X+}
{$ELSE}
{$A+,G+,B-,D-,E-,F+,I-,N-,R-,S-,V-,L-,Q-,Y-,K+,X+}
{$ENDIF}

Uses WinProcs, WinTypes, EWAPIIMP, Strings;

Const
  TwipsPerSpace = 120;
  DefaultFont : String[6] = '2';
  DefaultFontSize : String[10] = '20';
  ParaChar : Char = '`';
  Tokenleng = 28;         {Max symbol length}
  Tab = #9;
  MaxRes = 13;

Type
  Symb = (
    OtherChar, Comma, Colon, SemiColon, Lbrack, Rbrack, Dot, Slash,
    LLbrack, RRbrack, OtherPunct, Ident, EolSy, Space, ParaSy, TabSy,
    BuildTagSy, TopicSy, TitleSy, KeyWordSy, BrowseSy,
    TopicStart, TopicEnd, DocStartSy, DocEndSy, CommandSy, BMCSy, BMLSy,
    BMRSy, FontCommand, Number, BlockStartSy, BlockEndSy);
  SymString = string[14];

Var
  Sy, SaveSy : Symb;

Const
  ResWord : array[1..MaxRes] of SymString = (
    '\buildtag', '\topic', '\title', '\keyword', '\browse', '\bmc', '\bml',
    '\bmr', '\docstart', '\docend', '\tab', '\blockstart', '\blockend');
  ResSy : array[1..MaxRes] of Symb = (
    BuildTagSy, TopicSy, TitleSy, KeyWordSy, BrowseSy, BMCSy, BMLSy,
    BMRSy, DocStartSy, DocEndSy, TabSy, BlockStartSy, BlockEndSy);

Type
  TokenString = string[Tokenleng];
  String127 = string[127];
  Filestring = string[79];
  PairType = array[0..1] of Char;

Var
  BrackCount, LineNo, Chi, ErrCount : Integer;
  Pair : Word;
  Spair : PairType absolute Pair;
  LCh : Char absolute Pair;
  UCh : Char;
  St : String127;
  ErrFlag, EofInf, InInclude, InTopic : Boolean;
  SourceName : Filestring;
  Outf : Text;
  Value : LongInt;
  LCToken : TokenString;
  OutString, GlobalHeader, TopicHeader : String;
  BlockHeader : array[1..4] of String;
  BIndex : Integer;
  OutName : FileString;
  LineCount : integer;

const
  RTFTitle : PChar = 'Translate to RTF';

var
  SaveExit   : Pointer;  { Save ExitProc }
  RTFEntryId : longint;  { Entry Id for the "Translate to RTF" menu }

{-------------Error}
procedure Error(II :Integer; S : String127);

Var
  X,Y       : Integer;
  ActualCol : integer;
  Msg       : array[0..127] of char;

begin
  if II > 2 then
    ActualCol := II - 3
  else
    ActualCol := 0;
  Lineno := Pred(Lineno);
  if Lineno < 0 then
    Lineno := 0;
  EWGotoXY(ActualCol, Lineno);
  StrPCopy(Msg, S);
  EWWriteMessage(Msg);
  ErrFlag := true;
end;

{-------------SetWaitCursor}
procedure SetWaitCursor(state : boolean);

const
  OldCursor : HCursor = 0;

begin
  if state then
    OldCursor := SetCursor(LoadCursor(0, idc_Wait))
  else if OldCursor <> 0 then
    SetCursor(OldCursor);
end;


{-------------Positn}
function Positn(Pat, Src : String; I : Integer) : Integer;
{-Find the position of a substring in a string starting at the Ith char}

var
  N : Integer;

begin
  if I < 1 then
    I := 1;
  Delete(Src, 1, I-1);
  N := Pos(Pat, Src);
  if N = 0 then
    Positn := 0
  else
    Positn := N+I-1;
end;

{-------------HexString}
procedure HexString(Number : integer; var Result : String);

var
  Tmp : integer;
  i   : integer;

begin
  for i := 1 to 2 do begin
    Tmp := Number and $F;
    Number := Number shr 4;
    if Tmp >= 10 then
      Result[3-i] := Chr(Tmp - 10 + Ord('a'))
    else
      Result[3-i] := Chr(Tmp + Ord('0'));
  end;
  Result[0] := Char(2);
end;

{-------------ConvertForeign}
procedure ConvertForeign;
{-Makes sure that accented characters will be processed correctly}

var
  HexStr : String[2];
  RTFStr : String[4];
  i      : word;

begin
  i := 1;
  while not ErrFlag and (i <= Length(OutString)) do begin
    if Ord(OutString[i]) > $A0 then begin
      HexString(Ord(OutString[i]), HexStr);
      RTFStr := '\''' + HexStr;
      if Length(OutString) + 4 <= 255 then begin
        Delete(OutString, i , 1);
        Insert(RTFStr, OutString, i);
        Inc(i, 3);
      end else
        Error(i, 'Could not replace ANSI character with RTF command. Please split line.');
    end;
    Inc(i);
  end;
end;

{-------------OutFile}
procedure OutFile(S : String);

var
  WriteIt : boolean;
  Leng, I : Integer;

begin
{-A hard to find bug is mismatched braces. Keep count of these so can keep track of matching.}
  I := 0;
  repeat
    I := Positn('{', S, I+1);
    if (I > 0) then
      if not ((I > 1) and (S[I-1] = '\')) then
        Inc(BrackCount);
  until I = 0;
  repeat
    I := Positn('}', S, I+1);
    if (I > 0) then
      if not ((I > 1) and (S[I-1] = '\')) then
        Dec(BrackCount);
  until I = 0;

  {-Try to avoid hanging spaces on end of lines as editors delete them}
  Leng := Length(OutString)+Length(S);
  WriteIt := (Leng >= 75) and (OutString[Length(OutString)] <> ' ') or (Leng >= 200);
  if WriteIt then begin
    ConvertForeign;
    WriteLn(Outf, OutString);
    OutString := S;
  end else
    OutString := OutString+S;
  if IOResult <> 0 then
    Error(Lineno, 'I/O Error while writing Output File');
end;

{-------------Flush}
procedure Flush;

begin
  if Length(OutString) > 0 then begin
    ConvertForeign;
    WriteLn(Outf, OutString);
    OutString := '';
  end;
end;

{-------------GetCh}
procedure GetCh;
{-Return next char in Uch and Lch with Uch in upper case. Ignore comments}

Var
  Comment : Boolean;

  procedure GetchBasic;
  {-Read a character and a character pair}
  begin
    if Chi<=Ord(St[0]) then begin  {NOTE: pair has the same address as lch}
      Pair := MemW[DSeg : Ofs(St[Chi])];
      if (LCh=Tab) and not InTopic then
        LCh:=' ';
      UCh := UpCase(LCh);
      Chi := Chi+1;
    end else
      if Lineno < LineCount then begin
        St := StrPas(EWGetLineAt(Lineno));
        Inc(LineNo);
        St:=St+^M;  {Add EOL}
        Chi:=1;
        GetCh;
      end else begin
        EofInf:=True;
        if Comment then
          Error(Lineno, 'Open Comment at End of Input File');
      end;
  end;

begin  {Getch}
  repeat
    if EofInf then
      Error(Lineno, 'Unexpected End of Input File');
    Comment:=False;
    GetchBasic;
    if ErrFlag then
      Exit;
    if (SPair='(*') then begin
      Comment:=True;
      repeat
        GetchBasic;
      until ErrFlag or (SPair='*)');
      if not ErrFlag then
        GetchBasic;  {pass by the '*'}
    end;
  until ErrFlag or not Comment;
end;

{-----------IsPair}
function IsPair : Boolean;

Const
  Limit = 8;
  PA : array[1..Limit] of PairType = (
     '[[', ']]', '\[', '\]', '\\', '\`',
     '\{', '\}');        {!! <- if '`' made optional, change!!}
Var
  I : Integer;
  Was : Pairtype;

begin
  IsPair := False;
  for I := 1 to Limit do
    if PA[I] = Spair then begin
      Was := SPair;
      Sy := OtherPunct;
      IsPair := True;
      GetCh;
      case I of
        5,7,8 : LCToken := Was;
        1     : Sy := LLbrack;
        2     : Sy := RRbrack;
        else
          LCToken := LCh;
      end;
      GetCh;
      Exit;
    end;
end;

{-------------GetNumber}
function GetNumber : Boolean;  {Pick up a Number}

Var
  Done : Boolean;
  Code : Integer;

begin
  case UCh of
      '0'..'9' : LCToken := '';
     else begin
       GetNumber := False;
       Exit;
     end;
  end;
  GetNumber := True;
  Sy  := Number;
  Done := False;
  if not EofInf then
    while not ErrFlag and not Done do
      case UCh of
        '0'..'9' :
               begin
               LCToken := LCToken+UCh;
               GetCh;
               end;
        else
          Done := True;
      end;
  Val(LCToken, Value, Code);
end;

{-------------GetCommand}
function GetCommand : Boolean;  {Pick up a Command}

Label 2;

const
  MaxFC = 10;
  FontCommands : array[1..MaxFC] of string[6] =
    ('f', 'fs', 'b', 'i', 'strike', 'ul', 'ulw', 'uld', 'uldb',
     'plain');

Var
  Done : Boolean;
  I : Integer;
  AlphaOnly : TokenString;

begin
  GetCommand := False;
  if UCh <> '\' then
    Exit;
  GetCommand := True;
  Sy := CommandSy;
  LCToken := LCh;
  AlphaOnly := '';
  GetCh;
  Done := False;
  if not EofInf then begin
    while not ErrFlag and not Done do
      case LCh of
        'a'..'z' :
            begin
              if Length(LCToken)<Tokenleng then begin
                Inc(LCToken[0]);
                LCToken[Length(LCToken)] := LCh;
                Inc(AlphaOnly[0]);
                AlphaOnly[Length(AlphaOnly)] := LCh;
              end;
              GetCh;
            end;
        else
          Done := True;
      end;
    if LCh = '-' then begin
      if Length(LCToken)<Tokenleng then begin
        Inc(LCToken[0]);
        LCToken[Length(LCToken)] := LCh;
      end;
      GetCh;
    end;
    Done := False;
    while not ErrFlag and not Done do
      case LCh of
        '0'..'9' :
            begin
              if Length(LCToken)<Tokenleng then begin
                Inc(LCToken[0]);
                LCToken[Length(LCToken)] := LCh;
              end;
              GetCh;
            end;
        else
          Done := True;
       end;
    end;

  for I := 1 to MaxRes do
    if LCToken = ResWord[I] then begin
      Sy := ResSy[I];
      GOTO 2;
    end;
  if not InTopic then
    for I := 1 to MaxFC do
      if AlphaOnly = FontCommands[I] then begin
        Sy := FontCommand;
        GoTo 2;
      end;
  2 :    {account for possible space after command}
  if Length(LCToken)<Tokenleng then begin
    Inc(LCToken[0]);
    LCToken[Length(LCToken)] := ' ';
  end;
  if UCh = ' ' then
    GetCh;  {use up a space}
end;

{-------------GetIdent}
function GetIdent : Boolean;  {Pick up a Symbol}

Var
  Done : Boolean;
  I : Integer;

begin
  GetIdent := False;
  case UCh of
      'A'..'Z', '_' : ;
     else
       Exit;
  end;
  GetIdent := True;
  Sy := Ident;
  LCToken := LCh;
  GetCh;
  Done := False;
  if not EofInf then
    while not ErrFlag and not Done do
      case UCh of
        'A'..'Z', '0'..'9', '_' :
            begin
              if Length(LCToken)<Tokenleng then begin
                Inc(LCToken[0]);
                LCToken[Length(LCToken)] := LCh;
              end;
              GetCh;
            end;
        else
          Done := True;
      end;
end;

{-------------GetTopicEnd}
function GetTopicEnd : boolean;

begin
  GetTopicEnd := False;
  if UCh <> '-' then
    Exit;
  if Pos('----', St) <> 1 then
    Exit;
  Chi := Length(St)+1;      {ignore remainder of St}
  if not EofInf then
    GetCh;
  GetTopicEnd := True;
  if not InTopic then begin
    Error(Chi, '----- when not within topic');
    Exit;
  end;
  Sy := TopicEnd;
end;

{-------------GetTopicStart}
function GetTopicStart : boolean;

begin
  GetTopicStart := False;
  if UCh <> '=' then
    Exit;
  if Pos('====', St) <> 1 then
    Exit;
  Chi := Length(St)+1;      {ignore remainder of St}
  if not EofInf then
    GetCh;
  GetTopicStart := True;
  if InTopic then begin
    Error(Chi, '==== when already within topic');
    Exit;
  end;
  Sy := TopicStart;
end;

{-----------Punctuation}
function Punctuation : Boolean;
{-Check to see if Uch is a punctuation mark; if so, store the punctuation type in Sy}

Var
  I : Integer;

Const
  Punct : string[10] = ^M^I' :;[].';
  SyArray : array[1..8] of Symb = (EOLSy, TabSy, Space, Colon, SemiColon, Lbrack, Rbrack, Dot);

begin
  Punctuation := False;
  I := Pos(UCh, Punct);
  case I of
    1..8 : Sy := SyArray[I];
    else if UCH = ParaChar then
       Sy := ParaSy
     else
       Exit;
  end;
  Punctuation := True;
  case Sy of
    EOLSy  : LCToken := ' ';
    ParaSy : LCToken := '';
    TabSy  : LCToken := '\tab ';
    else
      LCToken := LCh;
  end;
  GetCh;
end;

{-----------Next}
procedure Next;
{-Get the next token on the command line}
begin
  if EofInf then begin
    Error(Lineno, 'Unexpected end of input file');
    Exit;
  end;
  if IsPair then
  else if GetCommand then
  else if GetIdent then
  else if GetNumber then
  else if GetTopicEnd then
  else if GetTopicStart then
  else if Punctuation then
  else begin
    Sy := OtherChar;
    LCToken := LCh;
    if not EOFinf then
      GetCh;
  end;
end;

{-------------SkipWhiteSpace}
procedure SkipWhiteSpace;

begin
  while not ErrFlag and ((UCh = ' ') or (UCh = Tab)) do
    GetCh;
end;

{-------------ParagraphText}
procedure ParagraphText;

  procedure DoBitmap;
  var
    S : String[30];
    Count : Integer;
  const
    FileChars : set of char =  ['A'..'Z', 'a'..'z', '0'..'9', '!', '#'..'''', '@', '^'..'`', '~'];
  begin
    OutFile('\{');
    case Sy of
      BMCSy : S := 'bmc ';
      BMRSy : S := 'bmr ';
      BMLSy : S := 'bml ';
      end;
    SkipWhiteSpace;
    Count := 0;
    while not ErrFlag and (LCH in FileChars) do begin
      S := S+LCh;
      GetCh;
      Inc(Count);
    end;
    if (Count > 8) or (Count = 0) then begin
      Error(Chi, 'Filename expected');
      Exit;
    end;
    if LCh = '.' then begin
      S := S+LCh;
      GetCh;
      Count  := 0;
      while not ErrFlag and (LCH in FileChars) do begin
        S := S+LCh;
        GetCh;
        Inc(Count);
      end;
      if (Count > 3) then begin
        Error(Chi, 'Filename expected');
        Exit;
      end;
    end;
    Next;
    OutFile(S+'\}');
  end;

  procedure CrossRef;
  var
    SyWas : Symb;
  begin
    SyWas := Sy;
    if Sy = LBrack then
      OutFile('{\uldb ')
    else
      OutFile('{\ul ');
    SkipWhiteSpace;
    Next;
    case Sy of
      BMCSy, BMLSy, BMRSy :
        begin
          DoBitmap;
          while not ErrFlag and (Sy = Space) do
            Next;
        end;
      else begin
        while not ErrFlag and (Sy <> Colon) and (Sy <> EOLSy) do begin
          OutFile(LCToken);
          Next;
        end;
      end;
    end;
    OutFile('}');
    if Sy <> Colon then begin
      Error(Chi, 'Colon expected');
      Exit;
    end;
    Next;   {use up colon}
    while not ErrFlag and (Sy = Space) do
      Next;
    if (Sy <> Ident) and (Sy <> Dot) and (Sy <> Number) then begin
      Error(Chi, 'Syntax Error in cross reference');
      Exit;
    end;
    OutFile('{\v ');
    repeat
      OutFile(LCToken);
      Next;
    until ErrFlag or ((Sy <> Ident) and (Sy <> Dot) and (Sy <> Number));
    OutFile('}');
    while not ErrFlag and (Sy = Space) do
      Next;
    if SyWas = LBrack then begin
      if Sy <> RBrack then
        Error(Chi, '] expected');
    end else if Sy <> RRbrack then
      Error(Chi, ']] expected');
  end;

begin
  while not ErrFlag
  and (Sy <> ParaSy)
  and (Sy <> TopicEnd)
  and (Sy <> BlockStartSy)
  and (Sy <> BlockEndSy) do begin
    case Sy of
       EOLSy   : begin
                   OutFile(' ');
                   SkipWhiteSpace;
                 end;
       LBrack,
       LLbrack : CrossRef;
       BMCSy,
       BMLSy,
       BMRSy   : DoBitmap;
       else
         OutFile(LCToken);
    end;
    if ErrFlag then
      Exit;
    Next;
  end;
  if Sy = ParaSy then begin
    repeat
      Next;   {skip trailing stuff, mainly spaces}
    until ErrFlag or (Sy = EOLSy);
    if not ErrFlag then
      Next;
  end;
end;

{-------------Paragraph}
procedure Paragraph;

var
  Count : Integer;
  S     : String[10];

begin
  repeat   {repeat ignores blank lines with spaces}
    while not ErrFlag and (Sy = EOLSy) do begin
      OutFile('\par');
      Next;
    end;
    Count := 0;
    while not ErrFlag and ((Sy = Space) or (Sy = TabSy)) do begin
      if Sy = TabSy then
        Count := ((Count div 5) +1) * 5 + 1
      else
        Inc(Count);
      Next;
    end;
  until ErrFlag or (Sy <> EOLSy);
  if (Sy <> TopicEnd) and (Sy <> BlockStartSy) and (Sy <> BlockEndSy) then begin
    if Count > 0 then begin
      Str(Count * TwipsPerSpace:-1, S);
      OutFile('\li'+S);
    end;
    {at start of each paragraph, output the paragraph commands entered in the headers}
    if BIndex > 0 then
      OutFile('{'+BlockHeader[BIndex])
    else
      OutFile('{'+GlobalHeader+TopicHeader);
    ParagraphText;   {do all the text}
    OutFile('}\par\pard');
    Flush;
  end;
end;

{-------------DoTopic}
procedure DoTopic;

begin
  OutFile('#{\footnote \pard\plain \sl240 \fs20 # ');
  SkipWhiteSpace;
  Next;
  while not ErrFlag and ((Sy = Ident) or (Sy = Dot) or (Sy = Number)) do begin
    OutFile(LCToken);
    Next;
  end;
  if Sy <> ParaSy then
    Error(Chi, 'Paragraph mark expected')
  else
    Next;
  if not ErrFlag then begin
    OutFile('}');
    Flush;
  end;
end;

{-------------DoBrowse}
procedure DoBrowse;

var
  Err : boolean;

begin
  OutFile('+{\footnote \pard\plain \sl240 \fs20 + ');
  SkipWhiteSpace;
  Next;
  repeat    {Browse symbol can contain many things up to ':' }
    case Sy of
      OtherChar, Comma,
      SemiColon, Lbrack,
      Rbrack,    Dot,
      Slash,     OtherPunct,
      Ident,     Space,
      TabSy,     Number : Err := False;
      else
        Err := True;
    end;
    if Err then begin
      Error(Chi, 'Syntax error in \Browse');
      Exit;
    end;
    OutFile(LCToken);
    Next;
  until ErrFlag or ((Sy = Colon) or (Sy = ParaSy) or (Sy = EOLsy));
  if Sy = Colon then begin
    SkipWhiteSpace;
    Next;
    if Sy <> Number then begin
      Error(Chi, 'Number expected in Browse');
      Exit;
    end;
    OutFile(':'+LCToken);
    SkipWhiteSpace;
    Next;
  end else
    Error(Chi, 'Colon expected');
  if Sy <> ParaSy then
    Error(Chi, 'Paragraph mark expected');
  if not ErrFlag then begin
    OutFile('}');
    Flush;
    Next;
  end;
end;

{-------------DoKeyWord}
procedure DoKeyWord;

var
  Err : boolean;
  Ch : Char;
  S : String[10];

begin
  case Sy of
    KeyWordSy  : Ch := 'K';
    TitleSy    : Ch := '$';
    BuildTagSy : Ch := '*';
  end;
  S := LCToken;   {save for possible error msg}
  OutFile(Ch+'{\footnote \pard\plain \sl240 \fs20 '+Ch+' ');
  SkipWhiteSpace;
  Next;
  repeat    {symbols can contain many things }
    case Sy of
        OtherChar,  Comma,
        Colon,      SemiColon,
        Lbrack,     Rbrack,
        Dot,        Slash,
        OtherPunct, Ident,
        Space,      TabSy,
        Number              : Err := False;
      else
        Err := True;
    end;
    if Err then begin
      Error(Chi, 'Syntax error in '+S);
      Exit;
    end;
    OutFile(LCToken);
    Next;
  until ErrFlag or ((Sy = ParaSy) or (Sy = EOLSy));
  if Sy <> ParaSy then begin
    Error(Chi, 'Paragraph mark expected');
    Exit;
  end;
  OutFile('}');
  Flush;
  Next;
end;

{-------------DoPage}
procedure DoPage;
begin
  InTopic := True;
  Next;
  while not ErrFlag and (Sy <> TopicEnd) do
    if Sy = BlockStartSy then begin
      if BIndex >= 4 then begin
        Error(Chi, 'Too many nested blocks');
        Exit;
      end else
        Inc(BIndex);
      BlockHeader[BIndex] := '';
      Next;
      while not ErrFlag and ((Sy <> ParaSy) and (Sy <> EOLSy)) do begin
        if Sy = CommandSy then
          BlockHeader[BIndex] := BlockHeader[BIndex]+LCToken
        else if Sy <> Space then begin
          Error(Chi, 'Command expected');
          Exit;
        end;
        Next;
      end;
      if Sy = ParaSy then
        Next;
      if Sy = EOLSy then
        Next;
    end else if Sy = BlockEndSy then begin
      if BIndex < 1 then begin
        Error(Chi, 'Unmatched \blockend');
        Exit;
      end else
        Dec(BIndex);
      while not ErrFlag and (Sy <> EOLSy) do
        Next;  {\BlockEnd should be on its own line}
      Next;
    end else
      Paragraph;
  if not EofInf then
    Next;
  OutFile('}\page');
  Flush;
  if BIndex <> 0 then begin
    Error(Chi, 'Unmatched \blockstart in previous topic');
    Exit;
  end;
  InTopic := False;
  if BrackCount <> 0 then begin
    Error(Chi, '{..} imbalance in last topic');
    Exit;
  end;
end;

{-------------DoDocument}
procedure DoDocument;

begin
  Flush;
  Next;
  if Sy <> DocEndSy then
    OutFile('{');
  while not ErrFlag and (Sy <> DocEndSy) do begin
    case Sy of
      TopicSy :        DoTopic;
      KeyWordSy,
      BuildTagSy,
      TitleSy :
                       DoKeyWord;
      BrowseSy :       DoBrowse;
      TopicStart :     begin
                         DoPage;
                         TopicHeader := '';   {get ready for a new topic header string}
                         while not ErrFlag and
                           ((Sy = EOLSy)
                         or (Sy = space)
                         or (Sy = TabSy)) do
                           Next;
                         if Sy <> DocEndSy then
                           Outfile('{');
                       end;
      EolSy :          Next;
      CommandSy :      begin
                         TopicHeader := TopicHeader+LCToken;  {add in commands}
                         Next;
                       end;
      FontCommand :    begin
                         OutFile(LCToken);
                         Next;
                       end;
      else Next;       {ignore other junk}
    end;
    if ErrFlag then
      Exit;
  end;
  Flush;
  OutFile('}');
end;

{-------------WRITEHEADING}

procedure WriteHeading;

begin
  Writeln(Outf, '{\rtf1\ansi \deff0');
  Writeln(Outf, '{\fonttbl{\f0\froman Tms Rmn;}{\f1\fdecor Symbol;}{\f2\fswiss Helv;}');
  Writeln(Outf, '{\f3\fmodern Courier;}');
  Writeln(Outf, '}');
  Writeln(Outf, '{\colortbl;');
  Writeln(Outf, '\red0\green0\blue0;\red0\green0\blue255;\red0\green255\blue255;');
  Writeln(Outf, '\red0\green255\blue0;');
  Writeln(Outf, '\red255\green0\blue255;\red255\green0\blue0;\red255\green255\blue0;');
  Writeln(Outf, '\red255\green255\blue255;}');
  if IOResult <> 0 then begin
    Close(Outf);
    Error(Lineno, 'I/O Error while creating File Header');
  end;
end;


{-------------EWEXECUTE}
function EWExecute(RoutineId : word) : integer; export;

var
 DotPos : word;

begin
  SetWaitCursor(true);
  LineCount := EWGetLineCount;
  ErrCount := 0;
  LineNo := 0;
  BIndex := 0;
  BrackCount := 0;
  OutString := '';
  GlobalHeader := '';
  TopicHeader := '';
  EofInf := False;
  InTopic := False;
  ErrFlag := False;
  InInclude := False;
  EWSaveFile(EWGetFileName(EWGetCurrentEditor));
  EWWriteMessage('Compiling...');
  UpdateWindow(EWGetWindowHandle);
  OutName := StrPas(EWGetFileName(EWGetCurrentEditor));
  DotPos := Pos('.', OutName);
  if DotPos <> 0 then
    Delete(OutName, DotPos, 255);
  OutName := OutName + '.RTF';
  Assign(Outf, OutName);
  ReWrite(Outf);
  WriteHeading;
  OutFile('\f'+DefaultFont+'\fs'+DefaultFontSize);
  St[0] := #0;
  Chi := 1;  {get the reading started}
  GetCh;
  Next;
  while not ErrFlag and not EofInf and (Sy <> DocStartSy) do begin
    if Sy = CommandSy then
      GlobalHeader := GlobalHeader+LCToken
    else if Sy = FontCommand then
      OutFile(LCToken);    {else ignore}
    Next;
  end;
  if Sy = DocStartSy then
    DoDocument;
  Flush;
  Close(Outf);
  if ErrFlag then
    Erase(Outf)
  else
    EWWriteMessage('Compiled successfully.');
  SetWaitCursor(false);
end;

procedure LibExit; far;
begin
 {-Remove menu item from the User Menu before unloading}
  EWRemoveMenuEntry(RTFEntryId);
  ExitProc := SaveExit;
end;

exports
  EWExecute     index 1;

begin
  SaveExit := ExitProc;
  ExitProc := @LibExit;
 {-Extension attaches itself to the user Menu}
 { Two commands are made available. Therefore we create two menu entries}
  RTFEntryId  := EWAddMenuEntry('ewrtfgen', RTFTitle, 0, EWMNU_Extension, 0);
end.